library('keras')
library('tensorflow')
library('tidyverse')
library('fs')
library('tfdatasets')
library('fields')
library('magick')
Ten kod wykonuje następujące czynności: najpierw definiuje funkcję convert_to_supported_format, która konwertuje obrazy do określonego formatu. Funkcja ta odczytuje obraz z podanej ścieżki, następnie tworzy nową ścieżkę dla przekonwertowanego obrazu z odpowiednim rozszerzeniem formatu. Następnie zapisuje przekonwertowany obraz do nowej lokalizacji i zwraca ścieżkę do nowego obrazu.
Dalej kod kopiuje pliki obrazowe do nowego katalogu "Image" na podstawie listy plików image_files_copy z oryginalnej lokalizacji /kaggle/input/flood-area-segmentation/Image. Następnie lista plików obrazowych jest tworzona w nowym katalogu "Image". Ostatnią operacją jest konwersja wszystkich obrazów w nowej lokalizacji za pomocą funkcji convert_to_supported_format i zapisanie wynikowych ścieżek do zmiennej converted_images za pomocą funkcji sapply.
#Przekształcenie formatu
convert_to_supported_format <- function(file_path, output_format = "jpeg") {
img <- image_read(file_path)
output_path <- sub("\\.[a-z]+$", paste0(".", output_format), file_path)
image_write(img, path = output_path, format = output_format)
return(output_path)
}
image_files_copy <- list.files(path = "/kaggle/input/flood-area-segmentation/Image", full.names = TRUE)
dir.create(file.path("Image"), recursive = TRUE, showWarnings = FALSE)
file.copy(image_files_copy, file.path("Image"))
image_files <- list.files(path = "/kaggle/working/Image", full.names = TRUE)
converted_images <- sapply(image_files, convert_to_supported_format)
input_dir <- "/kaggle/working/Image"
target_dir <- "/kaggle/input/flood-area-segmentation/Mask"
image_paths = tibble(input = dir_ls(input_dir, glob = "*.jpeg"),
target = dir_ls(target_dir, glob = "*.png"))
par(mfrow = c(1, 2))
#Imput image
display_image_tensor <- function(x, ..., max = 255,
plot_margins = c(0, 0, 0, 0)) {
if(!is.null(plot_margins))
par(mar = plot_margins)
x %>%
as.array() %>%
drop() %>%
as.raster(max = max) %>%
plot(..., interpolate = FALSE)
}
image_tensor <- image_paths$input[20] %>%
tf$io$read_file() %>%
tf$io$decode_jpeg()
str(image_tensor)
display_image_tensor(image_tensor)
#Target mask
display_target_tensor <- function(target) display_image_tensor(target)
target <- image_paths$target[20] %>%
tf$io$read_file() %>%
tf$io$decode_png()
str(target)
display_target_tensor(target)
<tf.Tensor: shape=(443, 760, 3), dtype=uint8, numpy=…> <tf.Tensor: shape=(443, 760, 1), dtype=uint8, numpy=…>
Przygotowanie danych rozpoczyna się od funkcji, która odczytuje i dekoduje obrazy z plików, umożliwiając opcjonalne przeskalowanie ich do określonych wymiarów. Następnie funkcja "make_dataset" wykorzystuje tę funkcję do stworzenia zbioru danych, który zawiera znormalizowane obrazy wejściowe i docelowe (np. obrazy i ich etykiety dla problemów segmentacji). Kolejne kroki obejmują normalizację wartości pikseli oraz organizację danych w paczki (batche), co jest kluczowe dla efektywnego uczenia modelu. Cały proces ma na celu przygotowanie danych w formacie odpowiednim do dalszego wykorzystania w treningu modelu, zapewniając ich spójność i gotowość do analizy przez algorytmy uczenia maszynowego.
tf_read_image <- function(path, format = "image", resize = NULL, ...) {
img <- path %>%
tf$io$read_file() %>%
tf$io[[paste0("decode_", format)]](...)
if (!is.null(resize)) {
img <- img %>%
tf$image$resize(as.integer(resize))
}
img
}
img_size <- c(256, 256)
tf_read_image_and_resize <- function(..., resize = img_size) {
tf_read_image(..., resize = resize)
}
# Funkcja do tworzenia datasetu
make_dataset <- function(paths_df) {
tensor_slices_dataset(paths_df) %>%
dataset_map(function(path) {
image <- path$input %>%
tf_read_image_and_resize("jpeg", channels = 3L)
target <- path$target %>%
tf_read_image_and_resize("png", channels = 1L)
# Normalizacja obrazów
image <- image / 255
target <- target / 255
list(image, target)
}) %>%
dataset_cache() %>%
dataset_shuffle(buffer_size = nrow(paths_df)) %>%
dataset_batch(32)
}
Zbiory danych są podzielone: 70% danych trafia do zbioru treningowego (train_paths), a pozostałe 30% jest przypisane do zbioru testowego (test_paths). Z zbioru treningowego losowo wybierane jest dodatkowo 15% danych, które tworzą zbiór walidacyjny (vali_paths). Każdy ze zbiorów jest następnie przekształcony za pomocą funkcji make_dataset.
set.seed(20)
train_idx = sample(1:nrow(image_paths), nrow(image_paths)*0.70)
train_paths <- image_paths[train_idx, ]
test_paths <- image_paths[-train_idx, ]
vali_paths = train_paths %>% sample_n(size = nrow(image_paths)*0.15)
train_dataset <- make_dataset(train_paths)
vali_dataset <- make_dataset(vali_paths)
test_dataset <- make_dataset(test_paths)
Opis architektury U-Net
conv_block <- function(inputs, num_filters) {
x <- layer_conv_2d(inputs, filters = num_filters, kernel_size = c(3, 3), activation = "relu", padding = "same")
x <- layer_dropout(x, rate = 0.1)
x <- layer_conv_2d(x, filters = num_filters, kernel_size = c(3, 3), activation = "relu", padding = "same")
return(x)
}
encoder_block <- function(input, num_filters) {
x <- conv_block(input, num_filters)
p <- layer_max_pooling_2d(x, pool_size = c(2, 2))
return(list(x, p))
}
decoder_block <- function(input, skip_features, num_filters) {
x <- layer_conv_2d_transpose(input, filters = num_filters, kernel_size = c(2, 2), strides = c(2, 2), padding = "same")
x <- layer_concatenate(list(x, skip_features))
x <- conv_block(x, num_filters)
return(x)
}
UNet <- function(input_size) {
input_layer_nodes <- 16
input <- layer_input(shape = input_size)
# Encoder
encoder1 <- encoder_block(input, input_layer_nodes * 1)
s1 <- encoder1[[1]]
p1 <- encoder1[[2]]
encoder2 <- encoder_block(p1, input_layer_nodes * 2)
s2 <- encoder2[[1]]
p2 <- encoder2[[2]]
encoder3 <- encoder_block(p2, input_layer_nodes * 4)
s3 <- encoder3[[1]]
p3 <- encoder3[[2]]
encoder4 <- encoder_block(p3, input_layer_nodes * 8)
s4 <- encoder4[[1]]
p4 <- encoder4[[2]]
# Bridge
b1 <- conv_block(p4, input_layer_nodes * 16)
# Decoder
d1 <- decoder_block(b1, s4, input_layer_nodes * 8)
d2 <- decoder_block(d1, s3, input_layer_nodes * 4)
d3 <- decoder_block(d2, s2, input_layer_nodes * 2)
d4 <- decoder_block(d3, s1, input_layer_nodes * 1)
output <- layer_conv_2d(d4, filters = 1, kernel_size = c(1, 1), padding = "same", activation = "sigmoid")
model <- keras_model(inputs = input, outputs = output, name = "U-Net")
return(model)
}
Intersection over Union (IoU) / Jaccard Index
IoU jest jedną z najczęściej stosowanych metryk do oceny segmentacji. Jest to stosunek przecięcia do sumy predykcji i rzeczywistej maski.
iou_metric <- custom_metric("iou", function(y_true, y_pred) {
y_pred <- k_round(y_pred)
intersection <- k_sum(y_true * y_pred)
sum <- k_sum(y_true + y_pred)
smooth <- 1e-6
(intersection + smooth) / (sum - intersection + smooth)
})
Funkcja aktywacji sigmoid w warstwie wyjściowej modelu oraz binary_crossentropy jako funkcja straty są używane wspólnie w celu skutecznego uczenia modelu do dokładnego segmentowania obrazów na dwie klasy: obszary zalanego oraz ziemi.
unet = UNet(c(img_size, 3))
unet %>% compile(optimizer="adam", loss='binary_crossentropy', metrics=c(iou_metric, 'accuracy'))
summary(unet)
Model: "U-Net"
________________________________________________________________________________
Layer (type) Output Shape Param # Connected to
================================================================================
input_1 (InputLayer) [(None, 256, 256 0 []
, 3)]
conv2d (Conv2D) (None, 256, 256, 448 ['input_1[0][0]']
16)
dropout (Dropout) (None, 256, 256, 0 ['conv2d[0][0]']
16)
conv2d_1 (Conv2D) (None, 256, 256, 2320 ['dropout[0][0]']
16)
max_pooling2d (MaxPoolin (None, 128, 128, 0 ['conv2d_1[0][0]']
g2D) 16)
conv2d_2 (Conv2D) (None, 128, 128, 4640 ['max_pooling2d[0][0]']
32)
dropout_1 (Dropout) (None, 128, 128, 0 ['conv2d_2[0][0]']
32)
conv2d_3 (Conv2D) (None, 128, 128, 9248 ['dropout_1[0][0]']
32)
max_pooling2d_1 (MaxPool (None, 64, 64, 3 0 ['conv2d_3[0][0]']
ing2D) 2)
conv2d_4 (Conv2D) (None, 64, 64, 6 18496 ['max_pooling2d_1[0][0]']
4)
dropout_2 (Dropout) (None, 64, 64, 6 0 ['conv2d_4[0][0]']
4)
conv2d_5 (Conv2D) (None, 64, 64, 6 36928 ['dropout_2[0][0]']
4)
max_pooling2d_2 (MaxPool (None, 32, 32, 6 0 ['conv2d_5[0][0]']
ing2D) 4)
conv2d_6 (Conv2D) (None, 32, 32, 1 73856 ['max_pooling2d_2[0][0]']
28)
dropout_3 (Dropout) (None, 32, 32, 1 0 ['conv2d_6[0][0]']
28)
conv2d_7 (Conv2D) (None, 32, 32, 1 147584 ['dropout_3[0][0]']
28)
max_pooling2d_3 (MaxPool (None, 16, 16, 1 0 ['conv2d_7[0][0]']
ing2D) 28)
conv2d_8 (Conv2D) (None, 16, 16, 2 295168 ['max_pooling2d_3[0][0]']
56)
dropout_4 (Dropout) (None, 16, 16, 2 0 ['conv2d_8[0][0]']
56)
conv2d_9 (Conv2D) (None, 16, 16, 2 590080 ['dropout_4[0][0]']
56)
conv2d_transpose (Conv2D (None, 32, 32, 1 131200 ['conv2d_9[0][0]']
Transpose) 28)
concatenate (Concatenate (None, 32, 32, 2 0 ['conv2d_transpose[0][0]',
) 56) 'conv2d_7[0][0]']
conv2d_10 (Conv2D) (None, 32, 32, 1 295040 ['concatenate[0][0]']
28)
dropout_5 (Dropout) (None, 32, 32, 1 0 ['conv2d_10[0][0]']
28)
conv2d_11 (Conv2D) (None, 32, 32, 1 147584 ['dropout_5[0][0]']
28)
conv2d_transpose_1 (Conv (None, 64, 64, 6 32832 ['conv2d_11[0][0]']
2DTranspose) 4)
concatenate_1 (Concatena (None, 64, 64, 1 0 ['conv2d_transpose_1[0][0]'
te) 28) , 'conv2d_5[0][0]']
conv2d_12 (Conv2D) (None, 64, 64, 6 73792 ['concatenate_1[0][0]']
4)
dropout_6 (Dropout) (None, 64, 64, 6 0 ['conv2d_12[0][0]']
4)
conv2d_13 (Conv2D) (None, 64, 64, 6 36928 ['dropout_6[0][0]']
4)
conv2d_transpose_2 (Conv (None, 128, 128, 8224 ['conv2d_13[0][0]']
2DTranspose) 32)
concatenate_2 (Concatena (None, 128, 128, 0 ['conv2d_transpose_2[0][0]'
te) 64) , 'conv2d_3[0][0]']
conv2d_14 (Conv2D) (None, 128, 128, 18464 ['concatenate_2[0][0]']
32)
dropout_7 (Dropout) (None, 128, 128, 0 ['conv2d_14[0][0]']
32)
conv2d_15 (Conv2D) (None, 128, 128, 9248 ['dropout_7[0][0]']
32)
conv2d_transpose_3 (Conv (None, 256, 256, 2064 ['conv2d_15[0][0]']
2DTranspose) 16)
concatenate_3 (Concatena (None, 256, 256, 0 ['conv2d_transpose_3[0][0]'
te) 32) , 'conv2d_1[0][0]']
conv2d_16 (Conv2D) (None, 256, 256, 4624 ['concatenate_3[0][0]']
16)
dropout_8 (Dropout) (None, 256, 256, 0 ['conv2d_16[0][0]']
16)
conv2d_17 (Conv2D) (None, 256, 256, 2320 ['dropout_8[0][0]']
16)
conv2d_18 (Conv2D) (None, 256, 256, 17 ['conv2d_17[0][0]']
1)
================================================================================
Total params: 1,941,105
Trainable params: 1,941,105
Non-trainable params: 0
________________________________________________________________________________
Trening modelu Unet na danych treningowych (train_dataset) przez 210 epok,używając zbioru walidacyjnego (vali_dataset) do oceny skuteczności modelu podczas treningu.
history_unet <- unet %>% fit(
train_dataset,
epochs = 210, #batch_size = 32
validation_data = vali_dataset)
plot(history_unet)
Spadek wartości loss oraz wzrost metryk accuracy i IoU na wykresie historii wskazuje na skuteczne i poprawne uczenie modelu w zadaniu segmentacji obrazu. Co więcej, nie występuje tutaj ani przeuczenia, ani niedouczenie. Model osiąga coraz lepsze wyniki w przewidywaniu klas pikseli oraz w odwzorowaniu rzeczywistych obszarów na obrazie, co potwierdza jego postęp w procesie treningu. Takie zachowanie jest pożądane i wskazuje na odpowiednią adaptację modelu do danych treningowych.
visualize_results <- function(model, dataset, num_images) {
par(mfrow = c(num_images, 3), mar = c(0.01,0.01,0.1,0.1))
options(repr.plot.width=20, repr.plot.height=num_images * 10)
for (i in 1:num_images) {
batch <- dataset %>% as_iterator() %>% iter_next()
images <- batch[[1]]
true_masks <- batch[[2]]
pred_masks <- model %>% predict(images)
# Extract one image and masks from the batch
image <- images[i,,,]
true_mask <- true_masks[i,,,]
pred_mask <- pred_masks[i,,,]
# Ensure true_mask and pred_mask are tensors
true_mask <- tf$convert_to_tensor(true_mask, dtype=tf$float32)
pred_mask <- tf$convert_to_tensor(pred_mask, dtype=tf$float32)
# Expand dimensions with integer axis
true_mask <- tf$expand_dims(true_mask, axis = as.integer(-1))
pred_mask <- tf$expand_dims(pred_mask, axis = as.integer(-1))
# Tile masks for visualization
true_mask_rgb <- tf$tile(true_mask, tf$constant(c(1L, 1L, 1L, 3L), dtype = tf$int32))
pred_mask_rgb <- tf$tile(pred_mask, tf$constant(c(1L, 1L, 3L), dtype = tf$int32))
# Convert tensor RGB to raster objects
true_mask_raster <- array(as.numeric(true_mask_rgb), dim=c(dim(true_mask_rgb)[1:2], 3))
pred_mask_raster <- array(as.numeric(pred_mask_rgb), dim=c(dim(pred_mask_rgb)[1:2], 3))
image <- as.raster(as.array(image))
# Plot the image and masks with titles
plot(as.raster(image), main = paste("Image", i), cex.main = 1.5) # Increase title font size
plot(as.raster(true_mask_raster), main = "True Mask")
plot(as.raster(pred_mask_raster), main = "Predicted Mask")
}
}
visualize_results(unet, vali_dataset, 5)
Po wizualizacji wyników działania segmentacji można zauważyć, że model działa prawidłowo i skutecznie wyróżnia interesujące nas obszary na obrazie. Prawidłowość działania modelu objawia się poprzez dokładne odwzorowanie granic oraz identyfikację obszarów zainteresowania, takich jak obszary zalanego czy ziemi. oprawność segmentacji potwierdza, że model nauczył się odpowiednich cech i wzorców charakterystycznych dla klasyfikacji pikseli.
pred = unet %>% predict(test_dataset)
unet %>% evaluate(test_dataset)
Podsumowując, uzyskane wyniki metryk loss, IoU i accuracy sugerują, że model Unet działa dobrze w zadaniu segmentacji obrazu na dwie klasy. Choć wartość straty jest umiarkowana, IoU i dokładność są na dobrym poziomie, co świadczy o skuteczności modelu w identyfikowaniu oraz odwzorowywaniu istotnych obszarów na obrazach testowych.